00100		TITLE LOOP	;	SUBROUTINE LOOP(I,J,L,M,N)
00200		ENTRY LOOP,FINDIT,PLACE,DPYNEW,MVBEAM,MVBX
00300		EXTERNAL ACCPOG,DPYOUT,.COMM.,XRN,AMOD,PTR,KJY,DPY
00400		DEFINE FIXX(N)
00500	<	JUMPGE	N,.+5
00600		MOVNS	N
00700		FIX 	N,233000    
00800		MOVNS	N
00900		CAIA
01000		FIX	N,233000 >	; TO FIX IT LIKE 'IFIX' DOES.
01100				;	DIMENSION N(1)
01200		MM←1 ↔ NN←2 ↔ J←3
01300	LOOP:	0
01320		HRRZI	5,@4(16)	; ADR. OF N
01400		MOVE	1,@3(16)
01500		ADD 	1,@(16) 	; M+I
01510		ADDI	1,-1(5)    ;ADR. OF N(M+I) IN 1 - FIRST PICKUP
01550		HRLZ	6,1
01600		MOVE	2,@(16)
01700		ADD	2,@2(16)	;I+L  -- NN, 1ST TIME
01725		ADDI	2,-1(5)    ;ADR. OF N(I+L) IN 2 - FIRST PUT DOWN
01750		HRR	6,2		;NOW M+I IN LEFT, I+L IN RIGHT
01800		MOVE	3,@1(16)
01900		ADD	3,@2(16) 	;J+L  
01950		ADDI	3,-1(5)		;N(J+L), ADR. OF LAST PUT
02100		BLT	6,(3)	; SHIFT 'EM
02900		JRA	16,5(16)
03500	
03600	PLACE:	0	;	FUNCTION PLACE(X)
03700	;	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/XRN/RN(4000)
03800	;	EQUIVALENCE (R11,RJQ(9)),(RD,RN(4000))
03900		MOVN	2,@(16) ;	PLACE=R11-ABS(RD-X)
04000		FADR	2,XRN+=3999 	;END
04100		MOVMS	2
04200		MOVE 	0,.COMM.+=12	;R11
04300		FSBR	0,2
04400		JRA	16,1(16)
04500	
04600	FINDIT:	0    ;	FUNCTION FINDIT(N)
04700		SETZ   ;	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
04800		HRRZ	1,@(16) ; COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
04900		HRRZI	2,PTR  ;	FINDIT=0
05000		ADDI	1,(2)  ;	L=PWDS(N)
05100		MOVE	2,-1(1) ;	IF(RN(L+1).NE.1)GO TO 377
05200		FIXX(2)         ;	IF(RN(L+2).EQ.R2)RETURN
05220		MOVEM	2,PTR+=251   ; SENDS BACK A NUM IN L
05300		HRRZI	3,XRN     ;377	FINDIT=-1
05400		ADDI	3,(2)   ;	END
05500		MOVE 5,(3)   ; RN(L+1)
05600		CAME	5,[1.0]
05700		JRST	FNEG
05800		MOVE	5,1(3)  ;RN(L+2)
05900		CAME	5,.COMM.
06000	FNEG:	SETO
06100		JRA	16,1(16)
06200	
06300	DPYNEW:	0    ;	SUBROUTINE DPYNEW
06400		JSA	16,ACCPOG    ; COMMON/DPY/ST(4000),WDS(250),MEDIT,IGO
06500		JUMP	[1]    ;	CALL ACCPOG(1)
06600		MOVE	2,DPY+=4251    ;	IF(IGO.GT.0)RETURN
06700		JUMPG	2,DB    ;	CALL DPYOUT(1)
06800		JSA	16,DPYOUT    ;	END
06900		JUMP	[1]
07000	DB:	JRA	16,(16)
07100	
07150	MEM:	0
07200	MVBEAM:	0  ;C  THESE MOVE ENDS OF PARTIAL INNER BEAMS.
07300		HRRZI	2,@(16) ;	SUBROUTINE MVBEAM(R,I,JY,L,W)
07400		ADD	2,@1(16)  ;C  L AND JY ARE FOR MOVES TO DIFF. STAFF.
07500		ADD	2,@2(16)  ;	DIMENSION R(1)
07600		MOVE	3,-1(2)  ;	Y=R(JY+I)
07700		MOVM	4,3   ;	Z=ABS(Y)
07800		CAMGE	4,[=100.0]  ;	IF(Z.LT.100.)GO TO 1
07900		JRST	MV1
08000	;C  NEXT FOR MINIS, DIAMONDS, 'X' NOTES. (LIMIT OF +-99 ON ALTITUDE.)
08010		MOVEM	3,MEM
08100		JSA	16,AMOD  ;	Y=AMOD(Y,100.)
08200		JUMP	MEM
08300		JUMP	[=100.0]  ; 0 HAS Y
08400		MOVE	5,@4(16)  ;	X=Y+W
08500		FADR	5,0
08600		MOVM	6,5  ;	Z=Z-ABS(Y)+ABS(X)
08700		MOVM	7,0 ;C  PUTS ALL INTO POSITIVE
08800		FADR	4,7
08900		FSBR	4,6
09000		SKIPGE 	5  ;	IF(X)Z=-Z
09100		MOVNS	4    ; Z
09200		JRST 	MV2 ;	GO TO 2
09300	MV1:	FADR	3,@4(16)  ;1	Z=Y+W
09400		MOVE	4,3   ; Z NOW IN 4
09500	MV2:	HRRZI	3,@(16) ;2	R(L+I)=Z
09600		ADD	3,@3(16)
09700		ADD	3,@1(16)
09800		MOVEM	4,-1(3)  ; PUT IT IN R(L+I)
09900		JRA	16,5(16)	; END
10000	
10100	MVBX:	0   ;	SUBROUTINE MVBX(I)
10200	;     COMMON R2,JA,CENTR,J2,RJQ(20),L,RDIS,JQ(18)/KJY/K,JY/XRN/R(4000)
10300		MOVE	2,@(16)  ;	EQUIVALENCE (R4,RJQ(2)),(R8,RJQ(6))
10400		ADD	2,KJY+1 ;	R(L+I)=R8+(R(JY+I)-R4)*RDIS
10420		HRRZI	4,XRN
10460		ADDI	2,(4)
10500		MOVE	3,-1(2)  ; R(JY+I)
10600		FSBR	3,.COMM.+5
10700		FMPR	3,.COMM.+=25  ; *RDIS
10800		FADR	3,.COMM.+=9   ; +R8
10900		MOVE	2,@(16)
11000		ADD	2,.COMM.+=24   ; + L
11050		ADDI	2,(4)
11100		MOVEM	3,-1(2)    ;R(L+I)
11200		JRA	16,1(16)
11300		END